Attribute VB_Name = "Module1"
Option Explicit

' Program: StoreTextInEssbase.xls
'
' Purpose: Demonstrate storing strings in Essbase
'
' Programmer: Chris Schulze
'
' Create Date: 2010.05.04
'
' Copyright: GNU VPL v3
'   http://www.gnu.org/licenses/gpl.html
' Notes and Warnings:
'   - Beware the Jabberwock, my son!
'   - in variable names, the prefix dbl is the abbreviated form of Double
'   - definitions: quotient = dividend / divisor
'     remainder is what is left over, if your round the quotient
'     down to an integer (e.g., 9/2 = 4, remainder 1.)
'===============================================================================


'-------------------------------------------------------------------------------
' input: the dividend and the divisor as Doubles
' output: the remainder, as a Double, or zero, if input(s) are too large for VBA
' I had to write this function because VBA's Mod operator FIRST converts all
' the arguments to Integer, then does the math, and Integers can't hold as large
' of a number as Double.  Blame Microsoft.  I do.
'-------------------------------------------------------------------------------
Private Function dblMod(ByVal dblDividend As Double, ByVal dblDivisor As Double)
  Dim dblQuotientRounded As Double
  Dim dblRemainder As Double
  
  dblQuotientRounded = _
    Application.WorksheetFunction.RoundDown(dblDividend / dblDivisor, 0)
  dblRemainder = dblDividend - dblQuotientRounded * dblDivisor
  If dblRemainder < 0 Then
    MsgBox "[" & dblRemainder & "]", , "Number too large"
    dblMod = 0
  Else
    dblMod = dblRemainder
  End If
End Function

'-------------------------------------------------------------------------------
' input: a Double (made from a compressed string) and a symbol set string
' output: a decompressed string
' Double are the largest type in VBA, and thus can hold the longest strings
' possible.
' Behavior is not defined for compressed strings that contain characters not
' in strSymbols.
'-------------------------------------------------------------------------------
Public Function stringFromDouble(ByVal dblInTotal As Double, ByVal strSymbols As String)
Attribute stringFromDouble.VB_Description = "convert a number back to a string"
Attribute stringFromDouble.VB_ProcData.VB_Invoke_Func = " \n14"
  Dim dblQuotient As Double
  Dim dblRemainder As Double
  Dim intBase As Integer
  Dim strRtn As String
  
  
  intBase = Len(strSymbols)
  dblQuotient = dblInTotal
  strRtn = ""
  
  Do
    dblRemainder = dblMod(dblQuotient, CDbl(intBase))
    ' Why this code below?
    ' A remainder of zero means it divided evenly, which means it is the
    ' last character in the symbol set.
    ' note: VBA subscripts starting at 1, not 0
    If dblRemainder = 0 Then
      dblRemainder = intBase
    End If
    strRtn = Mid(strSymbols, dblRemainder, 1) & strRtn
    dblQuotient = (dblQuotient - dblRemainder) / intBase
  Loop Until dblQuotient < intBase  ' I am consciously comparing a Double and an Int
  If dblQuotient <> 0 Then  ' saves us from the single character case
    strRtn = Mid(strSymbols, dblQuotient, 1) & strRtn
  End If
  stringFromDouble = strRtn
End Function

'-------------------------------------------------------------------------------
' input: a string to be compressed and the character set it is composed from
' output: the compressed form of the string as a "Double" data type
' Double seems the only way to store a number that is too large for Long.
' (I thought Decimal would be nice, after reading the help file, but the compiler
' complained there is no such thing as Decimal.)
' Behavior is a msgbox and exit for compressed strings that contain characters
' not in strSymbols.
'-------------------------------------------------------------------------------
Public Function doubleFromString(ByVal strIn As String, ByVal strSymbols As String)
Attribute doubleFromString.VB_Description = "convert a short string into a number"
Attribute doubleFromString.VB_ProcData.VB_Invoke_Func = " \n14"
  Dim intBase As Integer
  Dim intStrLen As Integer
  Dim intPower As Integer  ' used as an exponent
  Dim intCharIndex As Integer  ' place of a char in symbol array
  Dim dblSum As Double
  Dim strTmp As String
  Dim strLastChar As String


  intBase = Len(strSymbols)
  intStrLen = Len(strIn)
  intPower = 0
  strTmp = strIn
  dblSum = 0

  ' viable string length is a function of
  ' 1. VBA's capacity with Doubles, and
  ' 2. length of the symbol set
  ' Basically, for the symbol set of numbers and upper and lowercase letters,
  ' the empirical limit seems to be 8 characters.
  ' So I truncate them here.
  If intStrLen > 8 Then
    strTmp = Left(strTmp, 8)
    intStrLen = 8
  End If
  
  Do
    strLastChar = Right(strTmp, 1)
    intCharIndex = indexCharInString(strLastChar, strSymbols)
    If intCharIndex = 0 Then
      MsgBox "Char [" & strLastChar & "] not found", , "Error!"
      Exit Function
    End If
    dblSum = dblSum + intCharIndex * intBase ^ intPower
    
    strTmp = Left(strTmp, intStrLen - 1)  ' shorten the string
    intStrLen = Len(strTmp)
    intPower = intPower + 1
  Loop Until intStrLen = 0
  doubleFromString = dblSum
End Function


'-------------------------------------------------------------------------------
' input: a character chrIn
' output: index of character within the "array" strSymbols()
'         zero on not found
'         negative on error
'-------------------------------------------------------------------------------
Private Function indexCharInString(ByVal chrIn As String, ByVal strSymbols As String)
  Dim intIdx1 As Integer
  Dim intLenArray As Integer
  
  If Len(chrIn) > 1 Then
    ' msgbox is temporary code
    MsgBox "You input [" & chrIn & "]", , "Input String Too Long"
    indexCharInString = -1
    Exit Function
  End If
  
  intLenArray = Len(strSymbols)
  For intIdx1 = 1 To intLenArray
    If chrIn = Mid(strSymbols, intIdx1, 1) Then
      indexCharInString = intIdx1
      Exit Function
    End If
  Next intIdx1
  indexCharInString = 0
End Function
